SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00012 POINTERS, LINKING, LISTS, TREES 1 05-28-9313:54ALL SWAG SUPPORT TEAM DLLIST1.PAS IMPORT 9 { > Does anybody have any good source/Units For Turboπ > Pascal 6.0/7.0 For doing Double Linked List Fileπ > structures?π}ππTypeππ DLinkPtr = ^DLinkRecord;ππ DLinkRecord = Recordπ Data : Integer;π Next : DLinkPtr;π Last : DLinkPtr;π end;ππVarπ Current,π First,π Final,π Prev : DLinkPtr;π X : Byte;ππProcedure AddNode;πbeginπ if First = Nil thenπ beginπ New(Current);π Current^.Next:=Nil;π Current^.Last:=Nil;π Current^.Data:=32;π First:=Current;π Final:=Current;π endπ elseπ beginπ Prev:=Current;π New(Current);π Current^.Next:=Nil;π Current^.Last:=Prev;π Current^.Data:=54;π Prev^.Next:=Current;π Final:=Current;π end;πend;ππbeginπ First:=Nil;π For X:=1 to 10 Do AddNode;π Writeln('First: ',first^.data);π Writeln('Final: ',final^.data);π Writeln('Others:');π Writeln(first^.next^.data);ππend.π 2 05-28-9313:54ALL SWAG SUPPORT TEAM LINKLIST.PAS IMPORT 63 {πThe following is the LinkList Unit written by Peter Davis in his wonderfulπbut, unFortunately, short-lived newsletter # PNL002.ZIP. I have used thisπUnit to Write tests of three or four of the Procedures but have stumped my toeπon his DELETE_HERE Procedure, the last one in the Unit. I will post my testsπin the next message For any who may wish to see it: Pete's Unit is unmodified.π I almost think there is some kind of error in DELETE_HERE but he was tooπthorough For that. Can you, or someone seeing this show me how to use thisπProcedure? It will help me both With Pointers and With Units.ππHere is the Unit:π}ππUnit LinkList;ππ{ This is the linked list Unit acCompanying The Pascal NewsLetter, Issue #2.π This Unit is copyrighted by Peter Davis.π It may be freely distributed in un-modified Form, or modified For use inπ your own Programs. Programs using any modified or unmodified Form of thisπ(107 min left), (H)elp, More? Unit must include a run-time and source visible recognition of the author,π Peter Davis.π}ππ{ The DataType used is Integer, but may be changed to whatever data Typeπ that you want.π}ππInterfaceπππTypeπ DataType = Integer; { Change this data-Type to whatever you want }ππ Data_Ptr = ^Data_Rec; { Pointer to our data Records }ππ Data_Rec = Record { Our Data Record Format }π OurData : DataType;π Next_Rec : Data_Ptr;π end;πππProcedure Init_List(Var Head : Data_Ptr);πProcedure Insert_begin(Var Head : Data_Ptr; Data_Value : DataType);πProcedure Insert_end(Var Head : Data_Ptr; Data_Value : DataType);πProcedure Insert_In_order(Var Head : Data_Ptr; Data_Value : DataType);πFunction Pop_First(Var Head : Data_Ptr) : DataType;πFunction Pop_Last(Var Head : Data_Ptr) : DataType;πProcedure Delete_Here(Var Head : Data_Ptr; Our_Rec : Data_Ptr);ππππImplementationππProcedure Init_List(Var Head : Data_Ptr);ππbeginπ Head := nil;πend;ππProcedure Insert_begin(Var Head : Data_Ptr; Data_Value : DataType);ππ{ This Procedure will insert a link and value into theπ beginning of a linked list. }ππVarπ Temp : Data_Ptr; { Temporary Pointer. }ππbeginπ new(Temp); { Allocate our space in memory. }π Temp^.Next_Rec := Head; { Point to existing list. }π Head:= Temp; { Move head to new data item. }π Head^.OurData := Data_Value; { Insert Data_Value. }πend;ππProcedure Insert_end(Var Head : Data_Ptr; Data_Value : DataType);ππ{ This Procedure will insert a link and value into theπ end of the linked list. }ππVarπ Temp1, { This is where we're going to put new data }π Temp2 : Data_Ptr; { This is to move through the list. }ππbeginπ new(Temp1);π Temp2 := Head;π if Head=nil thenπ beginπ Head := Temp1; { if list is empty, insert first }π Head^.OurData := Data_Value; { and only Record. Add value and }π Head^.Next_Rec := nil; { then put nil in Next_Rec Pointer }π endπ elseπ beginπ { Go to the end of the list. Since Head is a Variable parameter,π we can't move it through the list without losing Pointer to theπ beginning of the list. to fix this, we use a third Variable:π Temp2.π }π While Temp2^.Next_Rec <> nil do { Find the end of the list. }π Temp2 := Temp2^.Next_Rec;ππ Temp2^.Next_Rec := Temp1; { Insert as last Record. }π Temp1^.Next_Rec := nil; { Put in nil to signify end }π Temp1^.OurData := Data_Value; { and, insert the data }π end;πend;ππProcedure Insert_In_order(Var Head : Data_Ptr; Data_Value : DataType);ππ{ This Procedure will search through an ordered linked list, findπ out where the data belongs, and insert it into the list. }ππVarπ Current, { Where we are in the list }π Next : Data_Ptr; { This is what we insert our data into. }ππbeginπ New(Next);π Current := Head; { Start at the top of the list. }ππ if Head = Nil thenπ beginπ Head:= Next;π Head^.OurData := Data_Value;π Head^.Next_Rec := Nil;π endπ elseπ { Check to see if it comes beFore the first item in the list }π if Data_Value < Current^.OurData thenπ beginπ Next^.Next_Rec := Head; { Make the current first come after Next }π Head := Next; { This is our new head of the list }π Head^.OurData := Data_Value; { and insert our data value. }π endπ elseπ beginπ { Here we need to go through the list, but always looking one stepπ ahead of where we are, so we can maintain the links. The methodπ we'll use here is: looking at Current^.Next_Rec^.OurDataπ A way to explain that in english is "what is the data pointed toπ by Pointer Next_Rec, in the Record pointed to by Pointerπ current." You may need to run that through your head a few timesπ beFore it clicks, but hearing it in English might make it a bitπ easier For some people to understand. }ππ While (Data_Value >= Current^.Next_Rec^.OurData) andπ (Current^.Next_Rec <> nil) doπ Current := Current^.Next_Rec;π Next^.OurData := Data_Value;π Next^.Next_Rec := Current^.Next_Rec;π Current^.Next_Rec := Next;π end;πend;ππFunction Pop_First(Var Head : Data_Ptr) : DataType;ππ{ Pops the first item off the list and returns the value to the caller. }ππVarπ Old_Head : Data_Ptr;ππbeginπ if Head <> nil then { Is list empty? }π beginπ Old_Head := Head;π Pop_First := Head^.OurData; { Nope, so Return the value }π Head := Head^.Next_Rec; { and increment head. }π Dispose(Old_Head); { Get rid of the old head. }π endπ elseπ beginπ Writeln('Error: Tried to pop an empty stack!');π halt(1);π end;πend;πππFunction Pop_Last(Var Head : Data_Ptr) : DataType;ππ{ This Function pops the last item off the list and returns theπ value of DataType to the caller. }ππVarπ Temp : Data_Ptr;ππbeginπ Temp := Head; { Start at the beginning of the list. }π if head = nil then { Is the list empty? }π beginπ Writeln('Error: Tried to pop an empty stack!');π halt(1);π endπ elseπ if head^.Next_Rec = Nil then { if there is only one item in list, }π beginπ Pop_Last := Head^.OurData; { Return the value }π Dispose(Head); { Return the memory to the heap. }π Head := Nil; { and make list empty. }π endπ elseπ beginπ While Temp^.Next_Rec^.Next_Rec <> nil do { otherwise, find the end }π Temp := Temp^.Next_rec;π Pop_Last := Temp^.Next_Rec^.OurData; { Return the value }π Dispose(Temp^.Next_Rec); { Return the memory to heap }π Temp^.Next_Rec := nil; { and make new end of list. }π end;πend;πππProcedure Delete_Here(Var Head : Data_Ptr; Our_Rec : Data_Ptr);πππ{ Deletes the node Our_Rec from the list starting at Head. The Procedureπ does check For an empty list, but it assumes that Our_Rec IS in the list.π}ππVarπ Current : Data_Ptr; { Used to move through the list. }ππbeginπ Current := Head;π if Current = nil then { Is the list empty? }π beginπ Writeln('Error: Cant delete from an empty stack.');π halt(1);π endπ elseπ begin { Go through list Until we find the one to delete. }π While Current^.Next_Rec <> Our_Rec doπ Current := Current^.Next_Rec;π Current ^.Next_Rec := Our_Rec^.Next_Rec; { Point around old link. }π Dispose(Our_Rec); { Get rid of the link.. }π end;πend;πππend.π 3 05-28-9313:54ALL SWAG SUPPORT TEAM LL-INSRT.PAS IMPORT 13 { The following Program yields output that indicates that I have it set upπcorrectly but With my scanty understanding of exactly how to handle a linkedπlist I would be surprised if it is. This is one difficult area in which Swanπis not quite as expansive as he might be.ππ I will appreciate critique and commentary on this if you are anybodyπwould be so kind as to give it:π}ππProgram InsertLink;πUses Crt;ππTypeπ Str15 = String[15];π Aptr = ^Link;π Link = Recordπ Data : Str15;π Node : Aptr;π end;ππVarπ FirstItem, NewItem, OldItem : Aptr;ππProcedure CreateList;πbeginπ Writeln('Linked list BEForE insertion of node.');π Writeln;π New(FirstItem);π FirstItem^.Data := 'inSERT ';π Write(FirstItem^.Data);π Write(' ');π New(FirstItem^.Node);π FirstItem^.Node^.Data := 'HERE';π Writeln(FirstItem^.Node^.Data);π FirstItem^.Node^.Node := NIL;πend;ππProcedure InsertALink;πbeginπ Writeln; Writeln;π Writeln('Linked list AFTER insertion of node.');π Writeln;π Write(FirstItem^.Data);π New(NewItem);π NewItem^.Node := OldItem^.Node;π OldItem^.Node := NewItem;π FirstItem^.Node^.Data := 'inSERTEDLinK';π Write(FirstItem^.Node^.Data);π New(FirstItem^.Node^.Node);π FirstItem^.Node^.Node^.Data := ' HERE';π Writeln(FirstItem^.Node^.Node^.Data);π FirstItem^.Node^.Node^.Node := NIL;πend;ππProcedure DisposeList;πbeginπ Dispose(FirstItem^.Node^.Node);π FirstItem^.Node := NIL;πend;ππbeginπ ClrScr;π CreateList;π Writeln;π InsertALink;π DisposeList;πend.π 4 05-28-9313:54ALL SWAG SUPPORT TEAM LL_TEST.PAS IMPORT 20 {πThis is the test Program that I drew up to test the Procedures in PeteπDavis' LinkList.Pas posted in the previous message. It could be a little moreπdressed up but it does work and offers some insight, I think, into the use ofπPointers and linked lists: note that I ran a little manual test to locate aπdesignated Pointer in a given list. Here it is:π}ππUsesπ Crt, LinkList;ππVarπ AList1, AList2, AList3, AList4 : Data_Ptr;π ANum : DataType;π Count : Integer;ππbeginπ ClrScr;π Init_List(AList1);π Writeln('Results of inserting links at the beginning of a list: ');π For Count := 1 to 20 doπ beginπ ANum := Count;π Write(' ',ANum);π Insert_begin(AList1, ANum); {pay out first link (1) to last (20) like}π {a fishing line With #-cards. You end up}π end; {with 20 in your hand going up to 1}π Writeln;π Writeln('Watch - Last link inserted is the highest number.');π Writeln('You are paying out the list like reeling out a fishing line,');π Writeln('Foot 1, Foot 2, Foot 3, etc. - last one is Foot 20.');π Writeln('Now, mentally reel in the line to the fourth number.');π Writeln(' ',alist1^.Next_Rec^.Next_Rec^.Next_Rec^.OurData);π Writeln;π Writeln('Now insert one additional number at beginning of list');π beginπ ANum := 21;π Insert_begin(AList1,ANum);π end;π Writeln(' ',AList1^.OurData);π Writeln;πππ Init_List(Alist2);π Writeln('Results of Inserting links in turn at the end of a list: ');π For Count := 1 to 20 doπ beginπ ANum := Count;π Write(' ',ANum);π Insert_end(Alist2,ANum);π end;π Writeln;π Writeln('note, just the reverse situation of the process above.');π Writeln('Reel in the line to the fourth number.');π Writeln(' ',Alist2^.Next_Rec^.Next_Rec^.Next_Rec^.OurData);π {We inserted at the end so we are now going out toward the 20}ππππ Init_List(Alist3);π Writeln('Results of Inserting links in turn in orDER');π For Count := 1 to 20 doπ beginπ Anum := Count;π Write(' ',ANum);π Insert_In_order(Alist3,ANum);π end;π Writeln;π Writeln(' ',Alist3^.Next_Rec^.Next_Rec^.Next_Rec^.OurData);ππend.π{π In Case anybody missed Pete Davis' Linklist Unit in the previousπmessage but may have it in her/his library (PNL002.ZIP) what I was asking isπsome help With writing code to test the Procedure DELETE_HERE which is the lastπProcedure in the Unit.π} 5 05-28-9313:54ALL SWAG SUPPORT TEAM OOP-LLST.PAS IMPORT 90 Program Linked;ππTypeπ FileDescriptor =π Objectπ Fpt : File;π Name : String[80];π HeaderSize: Word;π RecordSize: Word;π RecordPtr : Pointer;π SoftPut : Boolean;π IsOpen : Boolean;π CurRec : LongInt;ππ Constructor Init(Nam : String; Hdr : Word; Size : Word; Buff : Pointer;πPut : Boolean);π Destructor Done; Virtual;π Procedure OpenFile; Virtual;π Procedure CloseFile; Virtual;π Procedure GetRecord(Rec : LongInt);π Procedure PutRecord(Rec : LongInt);π end;ππ FileLable =π Recordπ Eof : LongInt;π MRD : LongInt;π Act : LongInt;π Val : LongInt;π Sync: LongInt;π end;ππ LabeledFile =π Object(FileDescriptor)π Header : FileLable;ππ Constructor Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π Destructor Done; Virtual;π Procedure OpenFile; Virtual;π Procedure CloseFile; Virtual;π Procedure WriteHeader;π Procedure ReadHeader;π Procedure AddRecord;π Procedure DelRecord(Rec : LongInt);π end;ππ DetailHeaderPtr = ^DetailHeader;π DetailHeader =π Recordπ Master : LongInt;π Prev : LongInt;π Next : LongInt;π end;ππ MasterHeaderPtr = ^MasterHeader;π MasterHeader =π Recordπ First : LongInt;π Last : LongInt;π end;ππ DetailFileDetailPtr = ^DetailFileDetail;π DetailFileDetail =π Object(LabeledFile)π Constructor Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π Procedure LinkChain(MR, Last, Curr : LongInt);π Procedure DelinkChain(Rec : LongInt);π end;ππ DetailFileMaster =π Object(LabeledFile)π Constructor Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π Procedure LinkDetail(DF : DetailFileDetailPtr);π Procedure DelinkDetail(DF : DetailFileDetailPtr; DR : LongInt);π Procedure GetFirst(DF : DetailFileDetailPtr);π Procedure GetLast(DF : DetailFileDetailPtr);π Procedure GetNext(DF : DetailFileDetailPtr);π Procedure GetPrev(DF : DetailFileDetailPtr);π end;ππ{---------------------------------------------------------------------------}ππConstructor FileDescriptor.Init(Nam : String; Hdr : Word; Size : Word; Buff :π Pointer; Put : Boolean);π beginπ IsOpen := False;π Name := Nam;π HeaderSize := Hdr;π RecordSize := Size;π RecordPtr := Buff;π SoftPut := Put;π CurRec := -1;π end;ππDestructor FileDescriptor.Done;π beginπ if SoftPut and (CurRec <> -1) thenπ PutRecord(CurRec);π if IsOpen thenπ CloseFile;π end;ππProcedure FileDescriptor.OpenFile;π beginπ if IsOpen thenπ Exit;π Assign(Fpt,Name);π {$I-}π Reset(Fpt,1);π if IoResult <> 0 thenπ ReWrite(Fpt,1);π if IoResult = 0 thenπ IsOpen := True;π {$I+}π CurRec := -1;π end;ππProcedure FileDescriptor.CloseFile;π beginπ if not IsOpen thenπ Exit;π {$I-}π Close(Fpt);π if IoResult = 0 thenπ IsOpen := False;π {$I+}π CurRec := -1;π end;ππProcedure FileDescriptor.GetRecord(Rec : LongInt);π Varπ Result : Word;π beginπ if not IsOpen thenπ Exit;π if CurRec = Rec thenπ Exit;π if SoftPut and (CurRec <> -1) thenπ PutRecord(CurRec);π {$I-}π if Rec = 0 thenπ beginπ Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,RecordPtr^,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π endπ elseπ beginπ Seek(Fpt,HeaderSize + (Rec - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,RecordPtr^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π end;π end;π {$I+}π CurRec := Rec;π end;ππProcedure FileDescriptor.PutRecord(Rec : LongInt);π Varπ Result : Word;π beginπ if not IsOpen thenπ Exit;π {$I-}π if Rec = 0 thenπ beginπ Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockWrite(Fpt,RecordPtr^,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π endπ elseπ beginπ Seek(Fpt,HeaderSize + (Rec - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockWrite(Fpt,RecordPtr^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π end;π end;π CurRec := Rec;π {$I+}π end;ππ{---------------------------------------------------------------------------}ππConstructor LabeledFile.Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π beginπ if Size < 4 thenπ beginπ WriteLN('Record size must be 4 or larger');π Fail;π end;π FileDescriptor.Init(Nam,Sizeof(Header),Size,Buff,Put);π Header.Eof := 0;π Header.MRD := 0;π Header.Act := 0;π Header.Val := 0;π Header.Sync:= 0;π end;ππDestructor LabeledFile.Done;π beginπ CloseFile;π FileDescriptor.Done;π end;ππProcedure LabeledFile.OpenFile;π beginπ FileDescriptor.OpenFile;π if IsOpen thenπ ReadHeader;π end;ππProcedure LabeledFile.CloseFile;π beginπ {$I-}π if IsOpen thenπ beginπ if SoftPut and (CurRec <> -1) thenπ PutRecord(CurRec);π Header.Val := 0;π WriteHeader;π CurRec := -1;π end;π FileDescriptor.CloseFile;π {$I+}π end;ππProcedure LabeledFile.ReadHeader;π Varπ Result : Word;π beginπ {$I-}π Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,Header,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π {$I+}π end;ππProcedure LabeledFile.WriteHeader;π Varπ Result : Word;π beginπ {$I-}π Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockWrite(Fpt,Header,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π {$I+}π end;ππProcedure LabeledFile.AddRecord;π Varπ TmpRec : Pointer;π Result : Word;π Next : LongInt;π beginπ {$I-}π if Header.MRD <> 0 thenπ beginπ GetMem(TmpRec,RecordSize);π Seek(Fpt,HeaderSize + (Header.MRD - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,TmpRec^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π Next := LongInt(TmpRec^);π PutRecord(Header.MRD);π Header.MRD := Next;π Header.Act := Header.Act + 1;π end;π FreeMem(TmpRec,RecordSize);π endπ elseπ beginπ PutRecord(Header.Eof);π Header.Eof := Header.Eof + 1;π Header.Act := Header.Act + 1;π end;π WriteHeader;π {$I+}π end;ππProcedure LabeledFile.DelRecord(Rec : LongInt);π Varπ TmpRec : Pointer;π Result : Word;π beginπ {$I-}π GetMem(TmpRec,RecordSize);π Seek(Fpt,HeaderSize + (Rec - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,TmpRec^,RecordSize,Result);π LongInt(TmpRec^) := Header.MRD;π BlockWrite(Fpt,TmpRec^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π Header.MRD := Rec;π Header.Act := Header.Act - 1;π WriteHeader;π end;π {$I+}π end;ππ{---------------------------------------------------------------------------}ππConstructor DetailFileDetail.Init(Nam : String; Size : Word; Buff : Pointer;πPut : Boolean);π beginπ if Size < 12 thenπ beginπ WriteLn('Detail File Records must be 12 Bytes or more');π Fail;π end;π LabeledFile.Init(Nam,Size,Buff,Put);π end;ππProcedure DetailFileDetail.LinkChain(MR, Last, Curr : LongInt);π Varπ Hdr : DetailHeaderPtr;π beginπ Hdr := RecordPtr;π if Last <> 0 thenπ beginπ GetRecord(Last);π Hdr^.Next := Curr;π PutRecord(Last);π end;π GetRecord(Curr);π Hdr^.Prev := Last;π Hdr^.Master := MR;π Hdr^.Next := 0;π PutRecord(Curr);π end;ππProcedure DetailFileDetail.DelinkChain(Rec : LongInt); Varπ Hdr : DetailHeaderPtr;π Tmp : LongInt;π beginπ Hdr := RecordPtr;π GetRecord(Rec);π if Hdr^.Next <> 0 thenπ beginπ Tmp := Hdr^.Prev;π GetRecord(Hdr^.Next);π Hdr^.Prev := Tmp;π PutRecord(CurRec);π GetRecord(Rec);π end;π if Hdr^.Prev <> 0 thenπ beginπ Tmp := Hdr^.Next;π GetRecord(Hdr^.Prev);π Hdr^.Next := Tmp;π PutRecord(CurRec);π GetRecord(Rec);π end;π Hdr^.Master := 0;π Hdr^.Next := 0;π Hdr^.Prev := 0;π PutRecord(Rec);π end;ππ{---------------------------------------------------------------------------}ππConstructor DetailFileMaster.Init(Nam : String; Size : Word; Buff : Pointer;πPut : Boolean);π beginπ if Size < 8 thenπ beginπ WriteLn('Master File Records must be 8 Bytes or more');π Fail;π end;π LabeledFile.Init(Nam,Size,Buff,Put);π end;ππProcedure DetailFileMaster.LinkDetail(DF : DetailFileDetailPtr);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π DF^.AddRecord;π DF^.LinkChain(CurRec,Hdr^.Last,DF^.CurRec);π Hdr^.Last := DF^.CurRec;π if Hdr^.First = 0 then Hdr^.First := DF^.CurRec;π PutRecord(CurRec);π end;ππProcedure DetailFileMaster.DelinkDetail(DF : DetailFileDetailPtr; DR :πLongInt);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π DF^.GetRecord(DR);π if Hdr^.Last = DR thenπ Hdr^.Last := DetailHeader(DF^.RecordPtr^).Prev;π if Hdr^.First = DR thenπ Hdr^.First := DetailHeader(DF^.RecordPtr^).Next;π DF^.DelinkChain(DR);π PutRecord(CurRec);π end;ππProcedure DetailFileMaster.GetFirst(DF : DetailFileDetailPtr);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π if Hdr^.First = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.First);π end;ππProcedure DetailFileMaster.GetLast(DF : DetailFileDetailPtr);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π if Hdr^.Last = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.Last);π end;ππProcedure DetailFileMaster.GetNext(DF : DetailFileDetailPtr);π Varπ Hdr : DetailHeaderPtr;π beginπ Hdr := DF^.RecordPtr;π if Hdr^.Next = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.Next);π end;ππProcedure DetailFileMaster.GetPrev(DF : DetailFileDetailPtr);π Varπ Hdr : DetailHeaderPtr;π beginπ Hdr := DF^.RecordPtr;π if Hdr^.Prev = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.Prev);π end;ππ{---------------------------------------------------------------------------}ππbeginπend.ππ 6 05-28-9313:54ALL SWAG SUPPORT TEAM PTR-MEM.PAS IMPORT 5 Program Test_Pointers;ππTypeπ Array_Pointer = ^MyArray;π MyArray = Array[1..10] of String;ππVarπ MyVar : Array_Pointer;ππbeginπ Writeln('Memory beFore initializing Variable : ',MemAvail);ππ New(MyVar);ππ Writeln('Memory after initializiation : ',MemAvail);ππ MyVar^[1] := 'Hello';π MyVar^[2] := 'World!';ππ Writeln(MyVar^[1], ' ', MyVar^[2]);ππ Dispose(MyVar);ππ Writeln('Memory after Variable memory released : ',MemAvail);πend.π 7 05-28-9313:54ALL SWAG SUPPORT TEAM PTRARRAY.PAS IMPORT 13 DS> Hi, I've recently encountered a problem With not having enough memoryπDS> to open a large sized Array [ie: 0..900]. Is there any way toπDS> allocate more memory to the Array as to make larger ArraysππArray of what? if the total size of the Array (i.e. 901 *πsizeof(whatever_it_is_you're_talking_about)) is less than 64K, it's a snap.πRead your dox on Pointers and the heap. You'll end up doing something likeπthis:ππTypeπ tWhatever : whatever_it_is_you're_talking_about;π tMyArray : Array[0..900] of tWhatever;π tPMyArray : ^MyArray;ππVarπ PMyArray : tPMyArray;ππbeginπ getmem(PMyArray,sizeof(tMyArray));ππ { now access your Array like this:π PMyArray^[IndexNo] }ππif your Array is >64K, you can do something like this:ππTypeπ tWhatever : whatever_it_is_you're_talking_about;π tPWhatever : ^tWhatever;ππVarπ MyArray : Array[0..900] of tPWhatever;π i : Word;ππbeginπ For i := 0 to 900 doπ getmem(MyArray[i],sizeof(tWhatever));ππ { now access your Array like this:π MyArray[IndexNo]^ }ππif you don't have enough room left in your data segment to use this latterπapproach (and I'll bet you do), you'll just need one more level of indirection.πDeclare one Pointer in the data segment that points to the Array of Pointers onπthe heap, which in turn point to your data.ππif you're a beginner, this may seem impossibly Complex (it did to me), but keepπat it and it will soon be second nature.π 8 05-28-9313:54ALL SWAG SUPPORT TEAM TREEHITE.PAS IMPORT 7 {πAuthors: Chet Kress and Jerome Tonnesonππ>Help !!! I need a Function or Procedure in standard pascal that willπ>calculate the height of a binary tree. It must be able to calculate theπ>height of the tree if the tree is either balanced, unbalanced or full.π>The Procedure must be recursive.ππHere are the only two Functions you will need.π}ππFunction Max(A, B : Integer) : Integer;πbegin {Max}π If A > B thenπ Max := A;π elseπ Max := B;πend; {Max}ππFunction Height (Tree : TreeType) : Integer;πbegin {Height}π If Tree = Nil thenπ Height := 0π elseπ Height := Max(Height(Tree^.Right), Height(Tree^.Left)) + 1;πend; {Height}π 9 06-22-9309:20ALL SWAG SUPPORT TEAM Generic Linked List IMPORT 34 UNIT LinkList;ππ{-------------------------------------------------π Generic linked list object -π-------------------------------------------------}ππ{***************************************************************}π INTERFACEπ{***************************************************************}ππTYPEππ { Generic Linked List Handler Definition }ππ NodeValuePtr = ^NodeValue;ππ NodeValue = OBJECTπ CONSTRUCTOR Init;π DESTRUCTOR Done; VIRTUAL;π END;ππ NodePtr = ^Node;π Node = RECORDπ Retrieve : NodeValuePtr;π Next : NodePtr;π END;πππ { Specific Linked List Handler Definition }ππ NodeListPtr = ^NodeList;ππ NodeList = OBJECTπ Items : NodePtr;π CONSTRUCTOR Init;π DESTRUCTOR Done; VIRTUAL;π PROCEDURE Add (A_Value : NodeValuePtr);ππ (* Iterator Functions *)ππ PROCEDURE StartIterator (VAR Ptr : NodePtr);π PROCEDURE NextValue (VAR Ptr : NodePtr);π FUNCTION AtEndOfList (Ptr : NodePtr) : Boolean;π END;ππ{***************************************************************}π IMPLEMENTATIONπ{***************************************************************}πππCONSTRUCTOR NodeValue.Init;πBEGINπEND;ππDESTRUCTOR NodeValue.Done;πBEGINπEND;ππCONSTRUCTOR NodeList.Init;πBEGINπ Items := NIL;πEND;ππDESTRUCTOR NodeList.Done;π VARπ Temp : NodePtr;πBEGINπ WHILE Items <> NIL DOπ BEGINπ Temp := Items;π IF Temp^.Retrieve <> NIL THENπ Dispose (Temp^.Retrieve, Done);π Items := Items^.Next;π Dispose (Temp);π END;πEND;ππPROCEDURE NodeList.Add (A_Value : NodeValuePtr);π VARπ Cell : NodePtr;π Temp : NodePtr;πBEGINπ (* Go TO the END OF the linked list. *)π Cell := Items;π IF Cell <> NIL THENπ WHILE Cell^.Next <> NIL DOπ Cell := Cell^.Next;ππ New (Temp);π Temp^.Retrieve := A_Value;π Temp^.Next := NIL;π IF Items = NILπ THENπ Items := Tempπ ELSEπ Cell^.Next := Temp;πEND;ππPROCEDURE NodeList.StartIterator (VAR Ptr : NodePtr);πBEGINπ Ptr := Items;πEND;ππPROCEDURE NodeList.NextValue (VAR Ptr : NodePtr);πBEGINπ IF Ptr <> NIL THENπ Ptr := Ptr^.Next;πEND;ππFUNCTION NodeList.AtEndOfList (Ptr : NodePtr) : Boolean;πBEGINπ AtEndOfList := (Ptr = NIL);πEND;ππEND.ππ{ DEMO PROGRAM }ππPROGRAM LL_Demo;ππUSES LinkList;ππ{ Turbo Pascal Linked List Object Example }ππTYPEππ DataValuePtr = ^DataValue;ππ DataValue = OBJECT (NodeValue)π Value : Real;π CONSTRUCTOR Init (A_Value : Real);π FUNCTION TheValue : Real;π END;ππ DataList = OBJECT (NodeList)π FUNCTION CurrentValue (Ptr : NodePtr) : Real;π PROCEDURE SetCurrentValue (Ptr : NodePtr; Value : Real);π END;ππVARπ Itr : NodePtr;π TestLink : DataList;ππ{------ Unique methods to create for your linked list type -----}ππCONSTRUCTOR DataValue.Init (A_Value : Real);πBEGINπ Value := A_Value;πEND;ππFUNCTION DataValue.TheValue : Real;πBEGINπ TheValue := Value;πEND;ππFUNCTION DataList.CurrentValue (Ptr : NodePtr) : Real;πBEGINπ CurrentValue := DataValuePtr (Ptr^.Retrieve)^.TheValue;πEND;ππPROCEDURE DataList.SetCurrentValue (Ptr : NodePtr; Value : Real);πBEGINπ DataValuePtr (Ptr^.Retrieve)^.Value := Value;πEND;πππBEGINπ TestLink.Init; {Create the list then add 5 values to it}ππ TestLink.Add (New (DataValuePtr, Init (1.0)));π TestLink.Add (New (DataValuePtr, Init (2.0)));π TestLink.Add (New (DataValuePtr, Init (3.0)));π TestLink.Add (New (DataValuePtr, Init (4.0)));π TestLink.Add (New (DataValuePtr, Init (5.0)));ππ TestLink.StartIterator (Itr); {Display the list on screen}π WHILE NOT TestLink.AtEndOfList (Itr) DO BEGINπ Write (TestLink.CurrentValue (Itr) : 5 : 1);π TestLink.NextValue (Itr);π END;π WriteLn;ππ TestLink.StartIterator (Itr); {Change some values in the list}π TestLink.SetCurrentValue (Itr, 0.0);π TestLink.NextValue (Itr);π TestLink.SetCurrentValue (Itr, -1.0);ππ TestLink.StartIterator (Itr); {Redisplay the list values}π WHILE NOT TestLink.AtEndOfList (Itr) DO BEGINπ Write (TestLink.CurrentValue (Itr) : 5 : 1);π TestLink.NextValue (Itr);π END;π WriteLn;π ReadLn;πEND.π 10 08-17-9308:39ALL SWAG SUPPORT TEAM Binary Tree - Linked ListIMPORT 73 ╙═ Unit BinTree;ππInterfaceππConst TOTAL_NODES = 100;ππType BTreeStr = String[40];π ShiftSet = (TiltL_Tilt, neutral, TiltR_Tilt);π BinData = Recordπ Key : BTreeStr;π End;π BinPtr = ^Bin_Tree_Rec;π Bin_Tree_Rec = Recordπ BTreeData : BinData;π Shift : ShiftSet;π TiltL, TiltR : BinPtr;π End;π BTreeRec = Array[1..TOTAL_NODES] of BinData;ππProcedure Ins_BinTreeπ (Var Rt : BinPtr;π Node : BinData);ππFunction Srch_BinTreeπ (Rt : BinPtr;π Node : BinData;π Index1 : Word) : Word;ππProcedure BSortArrayπ (Var Rt : BinPtr;π Var SortNode : BTreeRec;π Var Index : Word);ππProcedure Del_BinTreeπ (Var Rt : BinPtr;π Node : BinData;π Var DelFlag : Boolean);ππImplementationππProcedure Move_TiltR(Var Rt : BinPtr);ππ Varπ Ptr1, Ptr2 : BinPtr;ππ Beginπ Ptr1 := Rt^.TiltR;π If Ptr1^.Shift = TiltR_Tilt Then Beginπ Rt^.TiltR := Ptr1^.TiltL;π Ptr1^.TiltL := Rt;π Rt^.Shift := neutral;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltL;π Ptr1^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Ptr1;π Rt^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Rt;π If Ptr2^.Shift = TiltL_Tiltπ Then Ptr1^.Shift := TiltR_Tiltπ Else Ptr1^.Shift := neutral;π If Ptr2^.Shift = TiltR_Tiltπ Then Rt^.Shift := TiltL_Tiltπ Else Rt^.Shift := neutral;π Rt := Ptr2π End;π Rt^.Shift := neutralπ End;ππProcedure Move_TiltL(Var Rt : BinPtr);ππ Varπ Ptr1, Ptr2 : BinPtr;ππ Beginπ Ptr1 := Rt^.TiltL;π If Ptr1^.Shift = TiltL_Tilt Then Beginπ Rt^.TiltL := Ptr1^.TiltR;π Ptr1^.TiltR := Rt;π Rt^.Shift := neutral;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltR;π Ptr1^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Ptr1;π Rt^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Rt;π If Ptr2^.Shift = TiltR_Tiltπ Then Ptr1^.Shift := TiltL_Tiltπ Else Ptr1^.Shift := neutral;π If Ptr2^.Shift = TiltL_Tiltπ Then Rt^.Shift := TiltR_Tiltπ Else Rt^.Shift := neutral;π Rt := Ptr2;π End;π Rt^.Shift := neutralπ End;ππProcedure Ins_Bin(Var Rt : BinPtr;π Node : BinData;π Var InsOK : Boolean);ππ Beginπ If Rt = NIL Then Beginπ New(Rt);π With Rt^ Do Beginπ BTreeData := Node;π TiltL := NIL;π TiltR := NIL;π Shift := neutralπ End;π InsOK := TRUEπ Endπ Else If Node.Key <= Rt^.BTreeData.Key Then Beginπ Ins_Bin(Rt^.TiltL, Node, InsOK);π If InsOK Thenπ Case Rt^.Shift Ofπ TiltL_Tilt : Beginπ Move_TiltL(Rt);π InsOK := FALSEπ End;π neutral : Rt^.Shift := TiltL_Tilt;π TiltR_Tilt : Beginπ Rt^.Shift := neutral;π InsOK := FALSEπ End;π End;π Endπ Else Beginπ Ins_Bin(Rt^.TiltR, Node, InsOK);π If InsOK Thenπ Case Rt^.Shift Ofπ TiltL_Tilt : Beginπ Rt^.Shift := neutral;π InsOK := FALSEπ End;π neutral : Rt^.Shift := TiltR_Tilt;π TiltR_Tilt : Beginπ Move_TiltR(Rt);π InsOK := FALSEπ End;π End;π End;π End;ππProcedure Ins_BinTree(Var Rt : BinPtr;π Node : BinData);ππ Var Ins_ok : Boolean;ππ Beginπ Ins_ok := FALSE;π Ins_Bin(Rt, Node, Ins_ok)π End;ππFunction Srch_BinTree(Rt : BinPtr;π Node : BinData;π Index1 : Word)π : Word;ππ Varπ Index : Word;ππ Beginπ Index := 0;π While (Rt <> NIL) AND (Index < Index1) Doπ If Node.Key > Rt^.BTreeData.Key Then Rt := Rt^.TiltRπ Else if Node.Key < Rt^.BTreeData.Key Then Rt := Rt^.TiltLπ Else Beginπ Inc(Index);π Rt := Rt^.TiltLπ End;π Srch_BinTree := Indexπ End;ππProcedure Tvrs_Treeπ (Var Rt : BinPtr;π Var SortNode : BTreeRec;π Var Index : Word);ππ Beginπ If Rt <> NIL Then Beginπ Tvrs_Tree(Rt^.TiltL, SortNode, Index);π Inc(Index);π If Index <= TOTAL_NODES Thenπ SortNode[Index].Key := Rt^.BTreeData.Key;π Tvrs_Tree(Rt^.TiltR, SortNode, Index);π End;π End;ππProcedure BSortArrayπ (Var Rt : BinPtr;π Var SortNode : BTreeRec;π Var Index : Word);ππ Beginπ Index := 0;π Tvrs_Tree(Rt, SortNode, Index);π End;ππProcedure Shift_TiltRπ (Var Rt : BinPtr;π Var DelFlag : Boolean);ππ Varπ Ptr1, Ptr2 : BinPtr;π balnc2, balnc3 : ShiftSet;ππ Beginπ Case Rt^.Shift Ofπ TiltL_Tilt : Rt^.Shift := neutral;π neutral : Beginπ Rt^.Shift := TiltR_Tilt;π DelFlag := FALSEπ End;π TiltR_Tilt : Beginπ Ptr1 := Rt^.TiltR;π balnc2 := Ptr1^.Shift;π If NOT (balnc2 = TiltL_Tilt) Then Beginπ Rt^.TiltR := Ptr1^.TiltL;π Ptr1^.TiltL := Rt;π If balnc2 = neutral Then Beginπ Rt^.Shift := TiltR_Tilt;π Ptr1^.Shift := TiltL_Tilt;π DelFlag := FALSEπ Endπ Else Beginπ Rt^.Shift := neutral;π Ptr1^.Shift := neutral;π End;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltL;π balnc3 := Ptr2^.Shift;π Ptr1^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Ptr1;π Rt^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Rt;π If balnc3 = TiltL_Tilt Thenπ Ptr1^.Shift := TiltR_Tiltπ Elseπ Ptr1^.Shift := neutral;π If balnc3 = TiltR_Tilt Thenπ Rt^.Shift := TiltL_Tiltπ Elseπ Rt^.Shift := neutral;π Rt := Ptr2;π Ptr2^.Shift := neutral;π End;π End;π End;π End;ππProcedure Shift_TiltLπ (Var Rt : BinPtr;π Var DelFlag : Boolean);ππ Varπ Ptr1, Ptr2 : BinPtr;π balnc2, balnc3 : ShiftSet;ππ Beginπ Case Rt^.Shift Ofπ TiltR_Tilt : Rt^.Shift := neutral;π neutral : Beginπ Rt^.Shift := TiltL_Tilt;π DelFlag := Falseπ End;π TiltL_Tilt : Beginπ Ptr1 := Rt^.TiltL;π balnc2 := Ptr1^.Shift;π If NOT (balnc2 = TiltR_Tilt) Then Beginπ Rt^.TiltL := Ptr1^.TiltR;π Ptr1^.TiltR := Rt;π If balnc2 = neutral Then Beginπ Rt^.Shift := TiltL_Tilt;π Ptr1^.Shift := TiltR_Tilt;π DelFlag := FALSEπ Endπ Else Beginπ Rt^.Shift := neutral;π Ptr1^.Shift := neutral;π End;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltR;π balnc3 := Ptr2^.Shift;π Ptr1^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Ptr1;π Rt^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Rt;π If balnc3 = TiltR_Tilt Thenπ Ptr1^.Shift := TiltL_Tiltπ Elseπ Ptr1^.Shift := neutral;π If balnc3 = TiltL_Tilt Thenπ Rt^.Shift := TiltR_Tiltπ Elseπ Rt^.Shift := neutral;π Rt := Ptr2;π Ptr2^.Shift := neutral;π End;π End;π End;π End;ππProcedure Kill_Lo_Nodesπ (Var Rt,π Ptr : BinPtr;π Var DelFlag : Boolean);ππ Beginπ If Ptr^.TiltR = NIL Then Beginπ Rt^.BTreeData := Ptr^.BTreeData;π Ptr := Ptr^.TiltL;π DelFlag := TRUEπ Endπ Else Beginπ Kill_Lo_Nodes(Rt, Ptr^.TiltR, DelFlag);π If DelFlag Then Shift_TiltL(Ptr,DelFlag);π End;π End;ππProcedure Del_Bin(Var Rt : BinPtr;π Node : BinData;π Var DelFlag : Boolean);ππ Varπ Ptr : BinPtr;ππ Beginπ If Rt = NIL Thenπ DelFlag := Falseπ Elseπ If Node.Key < Rt^.BTreeData.Key Then Beginπ Del_Bin(Rt^.TiltL, Node, DelFlag);π If DelFlag Then Shift_TiltR(Rt, DelFlag);π Endπ Else Beginπ If Node.Key > Rt^.BTreeData.Key Then Beginπ Del_Bin(Rt^.TiltR, Node, DelFlag);π If DelFlag Then Shift_TiltL(Rt, DelFlag);π Endπ Else Beginπ Ptr := Rt;π If Rt^.TiltR = NIL Then Beginπ Rt := Rt^.TiltL;π DelFlag := TRUE;π Dispose(Ptr);π Endπ Else If Rt^.TiltL = NIL Then Beginπ Rt := Rt^.TiltR;π DelFlag := TRUE;π Dispose(Ptr);π Endπ Else Beginπ Kill_Lo_Nodes(Rt, Rt^.TiltL, DelFlag);π If DelFlag Then Shift_TiltR(Rt, DelFlag);π Dispose(Rt^.TiltL);π End;π End;π End;π End;ππProcedure Del_BinTreeπ (Var Rt : BinPtr;π Node : BinData;π Var DelFlag : Boolean);ππ Beginπ DelFlag := FALSE;π Del_Bin(Rt, Node, DelFlag)π End;πEnd. 11 08-27-9320:11ALL SWAG SUPPORT TEAM AVL Binary Trees IMPORT 52 ╙═ {π> Does anyone have code(preferably TP) the implements AVL trees?π> I'm having trouble With the insertion part of it. I'm writing a smallπ> parts inventory Program For work(although I'm not employed as aπ> Programmer) and the AVL tree would be very fast For it.π}πππProgram avl;ππTypeπ nodeptr = ^node;π node = Recordπ key : Char;π bal : -1..+1; { bal = h(right) - h(left) }π left,π right : nodeptrπ end;ππ tree = nodeptr;ππVarπ t : tree;π h : Boolean; { insert & delete parameter }πππProcedure maketree(Var t : tree);πbeginπ t := nil;πend;ππFunction member(k : Char; t : tree) : Boolean;πbegin { member }π if t = nil thenπ member := Falseπ elseπ if k = t^.key thenπ member := Trueπ elseπ if k < t^.key thenπ member := member(k, t^.left)π elseπ member := member(k, t^.right);πend;ππProcedure ll(Var t : tree);πVarπ p : tree;πbeginπ p := t^.left;π t^.left := p^.right;π p^.right := t;π t := p;πend;ππProcedure rr(Var t : tree);πVarπ p : tree;πbeginπ p := t^.right;π t^.right := p^.left;π p^.left := t;π t := p;πendππProcedure lr(Var t : tree);πbeginπ rr(t^.left);π ll(t);πend;ππProcedure rl(Var t : tree);πbeginπ ll(t^.right);π rr(t);πend;ππProcedure insert(k : Char; Var t : tree; Var h : Boolean);ππ Procedure balanceleft(Var t : tree; Var h : Boolean);π beginπ Writeln('balance left');π Case t^.bal ofπ +1 :π beginπ t^.bal := 0;π h := False;π end;π 0 : t^.bal := -1;π -1 :π begin { rebalance }π if t^.left^.bal = -1 thenπ begin { single ll rotation }π Writeln('single ll rotation');π ll(t);π t^.right^.bal := 0;π endπ else { t^.left^.bal = +1 }π begin { double lr rotation }π Writeln('double lr rotation');π lr(t);π if t^.bal = -1 thenπ t^.right^.bal := +1π elseπ t^.right^.bal := 0;π if t^.bal = +1 thenπ t^.left^.bal := -1π elseπ t^.left^.bal := 0;π end;π t^.bal := 0;π h := False;π end;π end;π end;ππ Procedure balanceright(Var t : tree; Var h : Boolean);π beginπ Writeln('balance right');π Case t^.bal ofπ -1 :π beginπ t^.bal := 0;π h := False;π end;π 0 : t^.bal := +1;π +1 :π begin { rebalance }π if t^.right^.bal = +1 thenπ begin { single rr rotation }π Writeln('single rr rotation');π rr(t);π t^.left^.bal := 0π endπ else { t^.right^.bal = -1 }π begin { double rl rotation }π Writeln('double rl rotation');π rl(t);π if t^.bal = -1 thenπ t^.right^.bal := +1π elseπ t^.right^.bal := 0;π if t^.bal = +1 thenπ t^.left^.bal := -1π elseπ t^.left^.bal := 0;π end;π t^.bal := 0;π h := False;π end;π end;π end;ππbegin { insert }π if t = nil thenπ beginπ new(t);π t^.key := k;π t^.bal := 0;π t^.left := nil;π t^.right := nil;π h := True;π endπ elseπ if k < t^.key thenπ beginπ insert(k, t^.left, h);π if h thenπ balanceleft(t, h);π endπ elseπ if k > t^.key thenπ beginπ insert(k, t^.right, h);π if h thenπ balanceright(t, h);π end;πend;ππProcedure delete(k : Char; Var t : tree; Var h : Boolean);ππ Procedure balanceleft(Var t : tree; Var h : Boolean);π beginπ Writeln('balance left');π Case t^.bal ofπ -1 :π beginπ t^.bal := 0;π h := True;π end;π 0 :π beginπ t^.bal := +1;π h := False;π end;π +1 :π begin { rebalance }π if t^.right^.bal >= 0 thenπ beginπ Writeln('single rr rotation'); { single rr rotation }π if t^.right^.bal = 0 thenπ beginπ rr(t);π t^.bal := -1;π h := False;π endπ elseπ beginπ rr(t);π t^.left^.bal := 0;π t^.bal := 0;π h := True;π end;π endπ else { t^.right^.bal = -1 }π beginπ Writeln('double rl rotation');π rl(t);π t^.left^.bal := 0;π t^.right^.bal := 0;π h := True;π end;π end;π end;π end;ππ Procedure balanceright(Var t : tree; Var h : Boolean);π beginπ Writeln('balance right');π Case t^.bal ofπ +1 :π beginπ t^.bal := 0;π h := True;π end;π 0 :π beginπ t^.bal := -1;π h := False;π end;π -1 :π begin { rebalance }π if t^.left^.bal <= 0 thenπ begin { single ll rotation }π Writeln('single ll rotation');π if t^.left^.bal = 0 thenπ beginπ ll(t);π t^.bal := +1;π h := False;π endπ elseπ beginπ ll(t);π t^.left^.bal := 0;π t^.bal := 0;π h := True;π end;π endπ else { t^.left^.bal = +1 }π begin { double lr rotation }π Writeln('double lr rotation');π lr(t);π t^.left^.bal := 0;π t^.right^.bal := 0;π h := True;π end;π end;π end;π end;ππ Function deletemin(Var t : tree; Var h : Boolean) : Char;π begin { deletemin }π if t^.left = nil thenπ beginπ deletemin := t^.key;π t := t^.right;π h := True;π endπ elseπ beginπ deletemin := deletemin(t^.left, h);π if h thenπ balanceleft(t, h);π end;π end;ππbegin { delete }π if t <> nil thenπ beginπ if k < t^.key thenπ beginπ delete(k, t^.left, h);π if h thenπ balanceleft(t, h);π endπ elseπ if k > t^.key thenπ beginπ delete(k, t^.right, h);π if h thenπ balanceright(t, h);π endπ elseπ if (t^.left = nil) and (t^.right = nil) thenπ beginπ t := nil;π h := True;π endπ elseπ if t^.left = nil thenπ beginπ t := t^.right;π h := True;π endπ elseπ if t^.right = nil thenπ beginπ t := t^.left;π h := True;π endπ elseπ beginπ t^.key := deletemin(t^.right, h);π if h thenπ balanceright(t, h);π end;π end;πend;ππbeginπend.π 12 09-26-9308:50ALL GARRY J. VASS Linked Lists in EMS SWAG9311 111 ╙═ {π PROTOTYPE PROCEDURES FOR CREATING AND ACCESSING SORTEDπ LINKED LISTS IN EXPANDED MEMORYππ GARRY J. VASS [72307,3311]ππThe procedures and functions given below present a prototypeπmethod for creating and accesing linked lists in expanded memory.πAlthough pointer variables are used in a way that appears toπconform to the TPascal pointer syntax, there are several majorπdifferences:ππ - there are none of the standard NEW, GETMEM,π MARK, RELEASE, DISPOSE, FREEMEM, and MAXAVAILπ calls made. These are bound to the program'sπ physical location in memory, and have noπ effect in expanded memory. Attempting toπ use these here, or to implement standardπ linked procedures by altering the HeapPtrπ standard variable is dangerous and highlyπ discouraged.π - pointer variables are set and queried byπ a simulation of TPascal's internal proceduresπ that is specially customized to the EMSπ page frame segment.π - the MEMAVAIL function is useless here. Theseπ procedures will support a list of up to 64K.ππThe general pseudo-code for creating a linked list in expandedπmemory is:ππ 1. Get a handle and allocate memory from the EMM.π 2. Get the page frame segment for the handle toπ mark the physical beginning of the list inπ expanded memory.π 3. Initialize the root pointer to the page frameπ segment.π 4. For each new record (or list member):ππ a. Calculate a new physical location for theπ record using a simulated normalizationπ procedure.π b. Set the appropriate values to theπ pointers using a simulated pointerπ assignment procedure.π c. Assure that the last logical recordπ contains a pointer value of NIL.ππAccessing the list is basically the same as the standard algorithms.ππThe procedures here assume that each list record (or member) is composedπof three elements:ππ - a pointer to the next logical record. If the member is theπ last logical record, this pointer is NIL.π - an index, or logical sort key. This value determines theπ logical position of the record in the list. These routinesπ and the demo use an integer type for index. The index,π however, can be of any type where ordinal comparisonsπ can be made, including pointers.π - an area for the actual data in each record. These routinesπ and the demo use a string of length 255, but this area canπ be of any type, including pointers to other lists.ππPlease note that these routines are exploratory and prototype. In no wayπare they intended to be definitive, accurate, efficient, or exemplary.ππAreas for further analysis are:ππ 1. A reliable analog to the MEMAVAIL function.π 2. Creating linked lists that cross handle boundaries.π 3. Creating linked lists that begin in heapspace andπ extend to expanded memory.π 4. A reliable method for assigning the standardπ variable, HeapPtr, to the base page.ππPlease let me know of your progress in these areas, or improvementsπto the routines below via the BORLAND SIG [72307,3311] or my PASCAL/πPROLOG SIG at the POLICE STATION BBS (201-963-3115).ππ}πPROGRAM LINKED_LISTS;πUses dos,crt;πCONSTπ ALLOCATE_MEMORY = $43;π EMS_SERVICES = $67;π FOREVER:BOOLEAN = FALSE;π GET_PAGE_FRAME = $41;π LOGICAL_PAGES = 5;π MAP_MEMORY = $44;π RELEASE_HANDLE = $45;πTYPEπ ANYSTRING = STRING[255];π LISTPTR = ^LISTREC;π LISTREC = RECORDπ NEXT_POINTER : LISTPTR;π INDEX_PART : INTEGER;π DATA_PART : ANYSTRING;π END;πVARπ ANYINTEGER : INTEGER;π ANYSTR : ANYSTRING;π HANDLE : INTEGER; { HANDLE ASSIGNED BY EMM }π LIST : LISTREC;π NEWOFFSET : INTEGER; { PHYSICAL OFFSET OF RECORD }π NEWSEGMENT : INTEGER; { PHYSICAL SEGMENT OF RECORD }π REGS1 : Registers;π ROOT : LISTPTR; { POINTER TO LIST ROOT }π SEGMENT : INTEGER; { PAGE FRAME SEGMENT }ππ{--------------------- GENERAL SUPPORT ROUTINES ----------------------}πFUNCTION HEXBYTE(N:INTEGER):ANYSTRING;πCONST H:ANYSTRING='0123456789ABCDEF';πBEGINπ HEXBYTE:=H[((LO(N)DIV 16)MOD 16)+1]+H[(LO(N) MOD 16)+1];πEND;ππFUNCTION HEXWORD(N:INTEGER):ANYSTRING;πBEGINπ HEXWORD:= HEXBYTE(HI(N))+HEXBYTE(LO(N));πEND;ππFUNCTION CARDINAL(I:INTEGER):REAL;πBEGINπ CARDINAL:=256.0*HI(I)+LO(I);πEND;ππPROCEDURE PAUSE;πVAR CH:CHAR;πBEGINπ WRITELN;WRITELN('-- PAUSING FOR KEYBOARD INPUT...');π READ(CH);π WRITELN;πEND;ππPROCEDURE DIE(M:ANYSTRING);πBEGINπ WRITELN('ERROR IN: ',M);π WRITELN('HALTING HERE, SUGGEST REBOOT');π HALT;πEND;πFUNCTION EXIST(FILENAME:ANYSTRING):BOOLEAN;VAR FILVAR:FILE;BEGIN ASSIGN(FILVAR,FILENAME);{$I-}πRESET(FILVAR);{$I+}EXIST := (IORESULT = 0);END;π{--------------------- END OF GENERAL SUPPORT ROUTINES ----------------}ππ{---------------------- EMS SUPPORT ROUTINES -------------------------}ππFUNCTION EMS_INSTALLED:BOOLEAN; { RETURNS TRUE IF EMS IS INSTALLED }πBEGIN { ASSURED DEVICE NAME OF EMMXXXX0 }π EMS_INSTALLED := EXIST('EMMXXXX0');{ BY LOTUS/INTEL/MS STANDARDS }πEND;ππFUNCTION NEWHANDLE(NUMBER_OF_LOGICAL_PAGES_NEEDED:INTEGER):INTEGER;πBEGINπ REGS1.AH := ALLOCATE_MEMORY;π REGS1.BX := NUMBER_OF_LOGICAL_PAGES_NEEDED;π INTR(EMS_SERVICES, REGS1);π IF REGS1.AH <> 0 THEN DIE('ALLOCATE MEMORY');π NEWHANDLE := REGS1.DX;πEND;ππPROCEDURE KILL_HANDLE(HANDLE_TO_KILL:INTEGER); { RELEASES EMS HANDLE. }πBEGIN { THIS MUST BE DONE IF }π REPEAT { OTHER APPLICATIONS ARE }π WRITELN('RELEASING EMS HANDLE'); { TO USE THE EM ARES. DUE}π REGS1.AH := RELEASE_HANDLE; { TO CONCURRENT PROCESSES,}π REGS1.DX := HANDLE_TO_KILL; { SEVERAL TRIES MAY BE }π INTR(EMS_SERVICES, REGS1); { NECESSARY. }π UNTIL REGS1.AH = 0;π WRITELN('HANDLE RELEASED');πEND;ππFUNCTION PAGE_FRAME_SEGMENT:INTEGER; { RETURNS PFS }πBEGINπ REGS1.AH := GET_PAGE_FRAME;π INTR(EMS_SERVICES, REGS1);π IF REGS1.AH <> 0 THEN DIE('GETTING PFS');π PAGE_FRAME_SEGMENT := REGS1.BX;πEND;ππPROCEDURE MAP_MEM(HANDLE_TO_MAP:INTEGER); {MAPS HANDLE TO PHYSICAL}πCONST PHYSICAL_PAGE = 0; {PAGES.}πBEGINπ REGS1.AH := MAP_MEMORY;π REGS1.AL := PHYSICAL_PAGE;π REGS1.BX := PHYSICAL_PAGE;π REGS1.DX := HANDLE_TO_MAP;π INTR(EMS_SERVICES, REGS1);π IF REGS1.AH <> 0 THEN DIE('MAPPING MEMORY');πEND;ππPROCEDURE GET_EMS_MEMORY(NUMBER_OF_16K_LOGICAL_PAGES:INTEGER);πVAR TH:INTEGER; { REQUESTS EM FROM EMM IN 16K INCREMENTS }πBEGINπ HANDLE := NEWHANDLE(NUMBER_OF_16K_LOGICAL_PAGES);π SEGMENT := PAGE_FRAME_SEGMENT;π MAP_MEM(HANDLE);πEND;π{----------------- END OF EMS SUPPORT ROUTINES -----------------------}ππ{----------------- CUSTOMIZED LINKED LIST SUPPORT ---------------------}πFUNCTION ABSOLUTE_ADDRESS(S, O:INTEGER):REAL; { RETURNS THE REAL }πBEGIN { ABSOLUTE ADDRESS }π ABSOLUTE_ADDRESS := (CARDINAL(S) * $10) { FOR SEGMENT "S" }π + CARDINAL(O); { AND OFFSET "O". }πEND;ππPROCEDURE NORMALIZE(VAR S, O:INTEGER); { SIMULATION OF TURBO'S INTERNAL }πVAR { NORMALIZATION ROUTINES FOR }π NEW_SEGMENT: INTEGER; { POINTER VARIABLES. }π NEW_OFFSET : INTEGER; { NORMALIZES SEGMENT "S" AND }πBEGIN { OFFSET "O" INTO LEGITAMATE }π NEW_SEGMENT := S; { POINTER VALUES. }π NEW_OFFSET := O;π REPEATπ CASE NEW_OFFSET OFπ $00..$0E : NEW_OFFSET := SUCC(NEW_OFFSET);π $0F..$FF : BEGINπ NEW_OFFSET := 0;π NEW_SEGMENT := SUCC(NEW_SEGMENT);π END;π END;π UNTIL (ABSOLUTE_ADDRESS(NEW_SEGMENT, NEW_OFFSET) >π ABSOLUTE_ADDRESS(S, O) + SIZEOF(LIST));π S := NEW_SEGMENT;π O := NEW_OFFSET;πEND;ππFUNCTION VALUEOF(P:LISTPTR):ANYSTRING; { RETURNS A STRING IN }π { SEGMENT:OFFSET FORMAT }π { WHICH CONTAINS VALUE }πBEGIN { OF A POINTER VARIABLE }π VALUEOF := HEXBYTE(MEM[SEG(P):OFS(P) + 3]) +π HEXBYTE(MEM[SEG(P):OFS(P) + 2]) +':'+π HEXBYTE(MEM[SEG(P):OFS(P) + 1]) +π HEXBYTE(MEM[SEG(P):OFS(P) + 0]);πEND;ππPROCEDURE SNAP(P:LISTPTR); { FOR THE RECORD BEING }πBEGIN { POINTED TO BY "P", THIS }π WRITELN(VALUEOF(P):10, { PRINTS THE SEGMENT/OFFSET }π VALUEOF(P^.NEXT_POINTER):20, { LOCATION, THE SEGMENT/ }π P^.INDEX_PART:5, { OFFSET OF THE RECORD PONTER, }π ' ',P^.DATA_PART); { RECORD INDEX, AND DATA. }πEND;ππPROCEDURE PROCESS_LIST; { GET AND PRINT MEMBERS OF A LIST }πVAR M1:LISTPTR; { SORTED IN INDEX ORDER. }πBEGINπ PAUSE;π M1 := ROOT;π WRITELN;π WRITELN('---------------- LINKED LIST ---------------------------------');π WRITELN('MEMBER LOCATION MEMBER CONTENTS');π WRITELN('IN MEMORY POINTER INDEX DATA ');π WRITELN('--------------- -----------------------------------------');π WRITELN;π REPEATπ SNAP(M1);π M1 := M1^.NEXT_POINTER;π UNTIL M1 = NIL;π WRITELN('------------ END OF LIST----------');πEND;ππPROCEDURE LOAD_MEMBER_HIGH (IND:INTEGER; DAT:ANYSTRING);πVAR M1:LISTPTR;π P:LISTPTR; { INSERTS A RECORD AT THE HIGH }πBEGIN { END OF THE LIST. }π M1 := ROOT;π REPEATπ IF M1^.NEXT_POINTER <> NIL THEN M1 := M1^.NEXT_POINTER;π UNTIL M1^.NEXT_POINTER = NIL;π NORMALIZE(NEWSEGMENT, NEWOFFSET);π M1^.NEXT_POINTER := PTR(NEWSEGMENT, NEWOFFSET);π P := M1^.NEXT_POINTER;π P^.INDEX_PART := IND;π P^.DATA_PART := DAT;π P^.NEXT_POINTER := NIL;πEND;ππPROCEDURE LOAD_MEMBER_MIDDLE (IND:INTEGER; DAT:ANYSTRING);πVAR M1:LISTPTR;π M2:LISTPTR;π P :LISTPTR;π T :LISTPTR;πBEGIN { INSERTS A MEMBER INTO THE MIDDLE }π M1 := ROOT; { OF A LIST. }π REPEATπ M2 := M1;π IF M1^.NEXT_POINTER <> NIL THEN M1 := M1^.NEXT_POINTER;π UNTIL (M1^.NEXT_POINTER = NIL) OR (M1^.INDEX_PART >= IND);π IF (M1^.NEXT_POINTER = NIL) ANDπ (M1^.INDEX_PART < IND) THENπ BEGINπ LOAD_MEMBER_HIGH (IND, DAT);π EXIT;π END;π T := M2^.NEXT_POINTER;π NORMALIZE(NEWSEGMENT, NEWOFFSET);π M2^.NEXT_POINTER := PTR(NEWSEGMENT, NEWOFFSET);π P := M2^.NEXT_POINTER;π P^.INDEX_PART := IND;π P^.DATA_PART := DAT;π P^.NEXT_POINTER := T;πEND;ππPROCEDURE LOAD_MEMBER (IND:INTEGER; DAT:ANYSTRING);πVAR M1:LISTPTR;πBEGINπ WRITELN('ADDING: ',DAT,' WITH AGE OF ',IND);π WRITELN('TURBO`S HEAP POINTER: ',VALUEOF(HEAPPTR),π ', MEMAVAIL = ',MEMAVAIL * 16.0:8:0);π WRITELN;π PAUSE;π WRITELN('... SEARCHING FOR ADD POINT ...');π IF ROOT^.INDEX_PART <= IND THEN { ENTRY POINT ROUTINE FOR }π BEGIN { ADDING NEW LIST MEMBERS }π LOAD_MEMBER_MIDDLE(IND, DAT); { ACTS ONLY IF NEW MEMBER }π EXIT; { SHOULD REPLACE CURRENT }π END; { ROOT. }π M1 := ROOT;π NORMALIZE(NEWSEGMENT, NEWOFFSET);π ROOT := PTR(NEWSEGMENT, NEWOFFSET);π ROOT^.INDEX_PART := IND;π ROOT^.DATA_PART := DAT;π ROOT^.NEXT_POINTER := M1;πEND;ππPROCEDURE INITIALIZE_ROOT_ENTRY(IND:INTEGER; DAT:ANYSTRING);πBEGINπ ROOT := PTR(NEWSEGMENT, NEWOFFSET); { INITIALIZES A LIST AND }π ROOT^.INDEX_PART := IND; { ADDS FIRST MEMBER AS }π ROOT^.DATA_PART := DAT; { "ROOT". }π ROOT^.NEXT_POINTER := NIL;πEND;ππBEGINπ TEXTCOLOR(15);π IF NOT EMS_INSTALLED THEN DIE('LOCATING EMS DRIVER');π CLRSCR;π WRITELN('DEMO OF LINKED LIST IN EXPANDED MEMORY...');π WRITELN('SETTING UP EMS PARAMETERS...');π GET_EMS_MEMORY(LOGICAL_PAGES);π WRITELN;π WRITELN('ASSIGNED HANDLE: ',HANDLE);π NEWSEGMENT := SEGMENT;π NEWOFFSET := 0;π WRITELN('EMS PARAMETERS SET. BASE PAGE IS: ',HEXWORD(SEGMENT));π WRITELN;π WRITELN('TURBO`S HEAP POINTER IS ',VALUEOF(HEAPPTR));π WRITELN('READY TO ADD RECORDS...');π PAUSE;ππ{ Demo: Create a linked list of names and ages with age as the index/sortπ key. Use random numbers for the ages so as to get a different sequenceπ each time the demo is run.}ππ INITIALIZE_ROOT_ENTRY(RANDOM(10) + 20, 'Anne Baxter (original root)');π LOAD_MEMBER(RANDOM(10) + 20, 'Rosie Mallory ');π LOAD_MEMBER(RANDOM(10) + 20, 'Sue Perkins ');π LOAD_MEMBER(RANDOM(10) + 20, 'Betty Williams ');π LOAD_MEMBER(RANDOM(10) + 20, 'Marge Holly ');π LOAD_MEMBER(RANDOM(10) + 20, 'Lisa Taylor ');π LOAD_MEMBER(RANDOM(10) + 20, 'Carmen Abigail ');π LOAD_MEMBER(RANDOM(10) + 20, 'Rhonda Perlman ');π PROCESS_LIST;π KILL_HANDLE(HANDLE);πEND.π
